home *** CD-ROM | disk | FTP | other *** search
/ Graphics Plus / Graphics Plus.iso / general / hdf / unix / examples.lha / examples / ann / file_annF.f < prev    next >
Encoding:
Text File  |  1991-10-25  |  4.3 KB  |  155 lines
  1. C
  2. C $Header: /pita/work/HDF/dev/RCS/test/annotations/file_ann_testF.f,v 1.1 90/06/27 11:18:51 mfolk beta $
  3. C
  4. C $Log:    file_ann_testF.f,v $
  5. c Revision 1.1  90/06/27  11:18:51  mfolk
  6. c Initial revision
  7. c 
  8. C
  9.  
  10.  
  11.       program file_ann_test
  12.  
  13. C Program to test routines for writing file IDs and file descriptions
  14. C
  15. C Mike Folk
  16.  
  17. C****||************************************************************
  18.  
  19.       integer dfile, i, ret, first, length
  20.       character*64 filename
  21.       character*7  baselabel
  22.       character*10 outlabel, inlabel
  23.       character*400 outdescr, indescr
  24.  
  25.       integer DFopen, DFclose, DFerrno, DFerror
  26.       integer DFANaddfid, DFANaddfds, DFANgetfid, DFANgetfds
  27.       integer DFANgetfidlen,  DFANgetfdslen
  28.  
  29.       integer DFE_NOERROR, DFACC_READ, DFACC_WRITE
  30.       integer DFAN_LABEL,DFAN_DESC
  31.       integer DFE_NOMATCH
  32.       integer MAXLABLEN, MAXDESCLEN
  33.  
  34.       character*1 CR
  35.  
  36.       parameter (DFE_NOERROR = 0, 
  37.      $           DFACC_READ  = 1, 
  38.      $           DFACC_WRITE = 2, 
  39.      $           DFAN_LABEL  = 0,  
  40.      $           DFAN_DESC   = 1,
  41.      $           MAXLABLEN   =10,
  42.      $           MAXDESCLEN  =400,
  43.      $           FIRST       = 1,
  44.      $           NOTFIRST    = 0,
  45.      $           DFE_NOMATCH = -29)
  46.  
  47. C****||***** store four file IDs in file ************************
  48.  
  49.       DFerror = DFE_NOERROR
  50.       CR      = char(10)
  51.  
  52.       print *, 'Enter HDF file name:'
  53.       read *, filename
  54.   
  55.       dfile = DFopen(filename, DFACC_WRITE, 0)
  56.       if (dfile .eq. 0) call fatalerror('Error opening file to write')
  57.  
  58.       baselabel = 'Label #'
  59.   
  60.       do 100 i=1,4
  61.           outlabel = baselabel//char(48+i)
  62.           ret = DFANaddfid (dfile, outlabel) 
  63.           if (ret .lt. 0) call fatalerror('Error adding label.')
  64.   100 continue 
  65.  
  66. C****||***** get and store file description in file ************
  67.  
  68.       call getdescr(outdescr)
  69.       ret = DFANaddfds (dfile, outdescr,len(outdescr))
  70.       if (ret .lt. 0) call fatalerror('Error adding description.')
  71.  
  72.       ret = DFclose(dfile)
  73.   
  74.   
  75. C****||***** read all file IDs from file *********************** 
  76.  
  77.       dfile = DFopen(filename, DFACC_READ, 0)
  78.       if (dfile .eq. 0) call fatalerror('Error opening file to read.')
  79.  
  80.       print *, '***** Now reading file ID lengths and IDs ******'
  81. C     *** first ID ***
  82.       length = DFANgetfidlen(dfile, FIRST)
  83.       ret = DFANgetfid(dfile,inlabel, MAXLABLEN, FIRST)
  84.   
  85. C     *** rest of IDs ***
  86.       do 200 while ( ret .ge. 0) 
  87.           print *,'Length: ',length,'  Ret:',ret,'  Label:',inlabel
  88.           length = DFANgetfidlen(dfile, NOTFIRST)
  89.           ret = DFANgetfid(dfile,inlabel, MAXLABLEN, NOTFIRST)
  90.   200 continue 
  91.  
  92.       if (DFerrno() .ne. DFE_NOMATCH) then 
  93.           call fatalerror('Error reading label.')
  94.       endif
  95.       print *, '*** End of file IDs ***'
  96.  
  97. C     *** read file description length and description ***
  98.       length = DFANgetfdslen(dfile, FIRST)
  99.       print *, 'Description length: ', length
  100.       ret = DFANgetfds (dfile, indescr, MAXDESCLEN, 1) 
  101.       if (ret .lt. 0) call fatalerror('Error reading description.')
  102.  
  103.       print *, '*** just read description.***'
  104.       print *, 'Description:',CR,indescr
  105.       print *, '*** End of description ***',CR
  106.       ret = DFclose(dfile)
  107.   
  108.       print *
  109.       print *
  110.       print *, '+++++++++++++++++++++++++'
  111.       print *
  112.       print *
  113.  
  114.       stop
  115.       end
  116.   
  117. C************************************************************
  118. * fatalerror: subroutine to report fatal error and abort
  119. *
  120. C****||***********************************************************
  121.  
  122.       subroutine fatalerror(s)
  123.       character*(*) s
  124.  
  125.       print *, s
  126.       print *, 'DFerror:', DFerrno()
  127.       print *, 'Program aborted.'
  128.       print *, ' '
  129.       stop
  130.       end
  131.  
  132.  
  133. C******************************************************************
  134. * getdescr: subroutine to put description in array
  135. *
  136. C****||************************************************************
  137.  
  138.       subroutine getdescr(s)
  139.       character*(*) s
  140.  
  141.       character*1  CR
  142.  
  143.       CR = char(10)
  144.  
  145.       s = ' This loop was used to write out labels.'//CR//CR
  146.      * // '      do 100 i=1,4' // CR
  147.      * // '        outlabel = baselabel//char(48+i)' // CR
  148.      * // '        ret = DFANaddfid(dfile,outlabel,len(outlabel))'//CR
  149.      * // '        if (ret.lt.0)fatalerror(''Error adding label.'')'//CR 
  150.      * // '  100 continue' // CR // CR
  151.      * // 'This is the end of the description.' // CR // CR
  152.  
  153.       return
  154.       end
  155.